more OsPath conversion (572/749)

Sponsored-by: Jack Hill

diff --git a/Command/P2P.hs b/Command/P2P.hs
index 14f6d24fa4390825dff6f6a6b581649e975359b4..c26b30374d1653f1ca7569e0497286c816c946a0 100644 (file)
--- a/Command/P2P.hs
+++ b/Command/P2P.hs
@@ -25,7 +25,6 @@ import Utility.Tmp.Dir
 import Utility.FileMode
 import Utility.ThreadScheduler
 import Utility.SafeOutput
-import qualified Utility.RawFilePath as R
 import qualified Utility.FileIO as F
 import qualified Utility.MagicWormhole as Wormhole
 
@@ -220,12 +219,12 @@ wormholePairing remotename ouraddrs ui = do
        -- files. Permissions of received files may allow others
        -- to read them. So, set up a temp directory that only
        -- we can read.
-       withTmpDir (toOsPath "pair") $ \tmp -> do
-               liftIO $ void $ tryIO $ modifyFileMode (toRawFilePath tmp) $ 
+       withTmpDir (literalOsPath "pair") $ \tmp -> do
+               liftIO $ void $ tryIO $ modifyFileMode tmp $ 
                        removeModes otherGroupModes
-               let sendf = tmp </> "send"
-               let recvf = tmp </> "recv"
-               liftIO $ writeFileProtected (toRawFilePath sendf) $
+               let sendf = tmp </> literalOsPath "send"
+               let recvf = tmp </> literalOsPath "recv"
+               liftIO $ writeFileProtected sendf $
                        serializePairData ourpairdata
 
                observer <- liftIO Wormhole.mkCodeObserver
@@ -235,18 +234,18 @@ wormholePairing remotename ouraddrs ui = do
                -- the same channels that other wormhole users use.
                let appid = Wormhole.appId "git-annex.branchable.com/p2p-setup"
                (sendres, recvres) <- liftIO $
-                       Wormhole.sendFile sendf observer appid
+                       Wormhole.sendFile (fromOsPath sendf) observer appid
                                `concurrently`
-                       Wormhole.receiveFile recvf producer appid
-               liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath sendf)
+                       Wormhole.receiveFile (fromOsPath recvf) producer appid
+               liftIO $ removeWhenExistsWith removeFile sendf
                if sendres /= True
                        then return SendFailed
                        else if recvres /= True
                                then return ReceiveFailed
                                else do
                                        r <- liftIO $ tryIO $
-                                               map decodeBS . fileLines' <$> F.readFile'
-                                                       (toOsPath (toRawFilePath recvf))
+                                               map decodeBS . fileLines'
+                                                       <$> F.readFile' recvf
                                        case r of
                                                Left _e -> return ReceiveFailed
                                                Right ls -> maybe 

diff --git a/Command/P2PHttp.hs b/Command/P2PHttp.hs
index ac72c7053da9a695563c73500b269658af9d6378..029307ed108fe7a16c1d07fd2269e0849cf74e1e 100644 (file)
--- a/Command/P2PHttp.hs
+++ b/Command/P2PHttp.hs
@@ -267,7 +267,7 @@ getAuthEnv = do
 findRepos :: Options -> IO [Git.Repo]
 findRepos o = do
        files <- concat
-               <$> mapM (dirContents . toRawFilePath) (directoryOption o)
+               <$> mapM (dirContents . toOsPath) (directoryOption o)
        map Git.Construct.newFrom . catMaybes 
                <$> mapM Git.Construct.checkForRepo files
 

diff --git a/Command/ReKey.hs b/Command/ReKey.hs
index a7a547b7196077faf14304e1e5c2df69f1cdefd3..3f02f2ab60ed0f367e2e28cafcafd23943f53c28 100644 (file)
--- a/Command/ReKey.hs
+++ b/Command/ReKey.hs
@@ -44,7 +44,7 @@ optParser desc = ReKeyOptions
 
 -- Split on the last space, since a FilePath can contain whitespace,
 -- but a Key very rarely does.
-batchParser :: String -> Annex (Either String (RawFilePath, Key))
+batchParser :: String -> Annex (Either String (OsPath, Key))
 batchParser s = case separate (== ' ') (reverse s) of
        (rk, rf)
                | null rk || null rf -> return $ Left "Expected: \"file key\""
@@ -52,7 +52,7 @@ batchParser s = case separate (== ' ') (reverse s) of
                        Nothing -> return $ Left "bad key"
                        Just k -> do
                                let f = reverse rf
-                               f' <- liftIO $ relPathCwdToFile (toRawFilePath f)
+                               f' <- liftIO $ relPathCwdToFile (toOsPath f)
                                return $ Right (f', k)
 
 seek :: ReKeyOptions -> CommandSeek
@@ -65,9 +65,9 @@ seek o = case batchOption o of
                (reKeyThese o)
   where
        parsekey (file, skey) =
-               (toRawFilePath file, fromMaybe (giveup "bad key") (deserializeKey skey))
+               (toOsPath file, fromMaybe (giveup "bad key") (deserializeKey skey))
 
-start :: SeekInput -> (RawFilePath, Key) -> CommandStart
+start :: SeekInput -> (OsPath, Key) -> CommandStart
 start si (file, newkey) = lookupKey file >>= \case
        Just k -> go k
        Nothing -> stop
@@ -79,7 +79,7 @@ start si (file, newkey) = lookupKey file >>= \case
 
        ai = ActionItemTreeFile file
 
-perform :: RawFilePath -> Key -> Key -> CommandPerform
+perform :: OsPath -> Key -> Key -> CommandPerform
 perform file oldkey newkey = do
        ifM (inAnnex oldkey) 
                ( unlessM (linkKey file oldkey newkey) $
@@ -93,7 +93,7 @@ perform file oldkey newkey = do
 
 {- Make a hard link to the old key content (when supported),
  - to avoid wasting disk space. -}
-linkKey :: RawFilePath -> Key -> Key -> Annex Bool
+linkKey :: OsPath -> Key -> Key -> Annex Bool
 linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
        ( linkKey' DefaultVerify oldkey newkey
        , do
@@ -101,7 +101,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
                 - it's hard linked to the old key, that link must be broken. -}
                oldobj <- calcRepo (gitAnnexLocation oldkey)
                v <- tryNonAsync $ do
-                       st <- liftIO $ R.getFileStatus file
+                       st <- liftIO $ R.getFileStatus (fromOsPath file)
                        when (linkCount st > 1) $ do
                                freezeContent oldobj
                                replaceWorkTreeFile file $ \tmp -> do
@@ -132,7 +132,7 @@ linkKey' v oldkey newkey =
                oldobj <- calcRepo (gitAnnexLocation oldkey)
                isJust <$> linkOrCopy' (return True) newkey oldobj tmp Nothing
 
-cleanup :: RawFilePath -> Key -> (MigrationRecord -> Annex ()) -> CommandCleanup
+cleanup :: OsPath -> Key -> (MigrationRecord -> Annex ()) -> CommandCleanup
 cleanup file newkey a = do
        newkeyrec <- ifM (isJust <$> isAnnexLink file)
                ( do
@@ -141,7 +141,8 @@ cleanup file newkey a = do
                        stageSymlink file sha
                        return (MigrationRecord sha)
                , do
-                       mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
+                       mode <- liftIO $ catchMaybeIO $ 
+                               fileMode <$> R.getFileStatus (fromOsPath file)
                        liftIO $ whenM (isJust <$> isPointerFile file) $
                                writePointerFile file newkey mode
                        sha <- hashPointerFile newkey

diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs
index efcac6fd50bf211420efbe6afcbdab5f359f9142..b1cd9262365cf9d86432b85ed4c3d512c68b348b 100644 (file)
--- a/Command/RecvKey.hs
+++ b/Command/RecvKey.hs
@@ -39,4 +39,4 @@ start (_, key) = fieldTransfer Download key $ \_p -> do
        go tmp = unVerified $ do
                opts <- filterRsyncSafeOptions . maybe [] words
                        <$> getField "RsyncOptions"
-               liftIO $ rsyncServerReceive (map Param opts) (fromRawFilePath tmp)
+               liftIO $ rsyncServerReceive (map Param opts) (fromOsPath tmp)

diff --git a/Command/Reinject.hs b/Command/Reinject.hs
index dbd96a9fdb26f9646e469b121b867db9138e9247..7ea45623fb6334ef18b65b94635007a50eea8b09 100644 (file)
--- a/Command/Reinject.hs
+++ b/Command/Reinject.hs
@@ -57,26 +57,26 @@ startSrcDest :: (SeekInput, (String, String)) -> CommandStart
 startSrcDest (si, (src, dest))
        | src == dest = stop
        | otherwise = starting "reinject" ai si $ notAnnexed src' $
-               lookupKey (toRawFilePath dest) >>= \case
+               lookupKey (toOsPath dest) >>= \case
                        Just key -> ifM (verifyKeyContent key src')
                                ( perform src' key
                                , do
                                        qp <- coreQuotePath <$> Annex.getGitConfig
                                        giveup $ decodeBS $ quote qp $ QuotedPath src'
                                                <> " does not have expected content of "
-                                               <> QuotedPath (toRawFilePath dest)
+                                               <> QuotedPath (toOsPath dest)
                                )
                        Nothing -> do
                                qp <- coreQuotePath <$> Annex.getGitConfig
                                giveup $ decodeBS $ quote qp $ QuotedPath src'
                                        <> " is not an annexed file"
   where
-       src' = toRawFilePath src
+       src' = toOsPath src
        ai = ActionItemOther (Just (QuotedPath src'))
 
 startGuessKeys :: FilePath -> CommandStart
 startGuessKeys src = starting "reinject" ai si $ notAnnexed src' $
-       case fileKey (toRawFilePath (takeFileName src)) of
+       case fileKey (takeFileName src') of
                Just key -> ifM (verifyKeyContent key src')
                        ( perform src' key
                        , do
@@ -88,7 +88,7 @@ startGuessKeys src = starting "reinject" ai si $ notAnnexed src' $
                        warning "Not named like an object file; skipping"
                        next $ return True
   where
-       src' = toRawFilePath src
+       src' = toOsPath src
        ai = ActionItemOther (Just (QuotedPath src'))
        si = SeekInput [src]
 
@@ -102,12 +102,12 @@ startKnown src = starting "reinject" ai si $ notAnnexed src' $ do
                        next $ return True
                )
   where
-       src' = toRawFilePath src
+       src' = toOsPath src
        ks = KeySource src' src' Nothing
        ai = ActionItemOther (Just (QuotedPath src'))
        si = SeekInput [src]
 
-notAnnexed :: RawFilePath -> CommandPerform -> CommandPerform
+notAnnexed :: OsPath -> CommandPerform -> CommandPerform
 notAnnexed src a = 
        ifM (fromRepo Git.repoIsLocalBare)
                ( a
@@ -120,7 +120,7 @@ notAnnexed src a =
                        Nothing -> a
                )
 
-perform :: RawFilePath -> Key -> CommandPerform
+perform :: OsPath -> Key -> CommandPerform
 perform src key = do
        maybeAddJSONField "key" (serializeKey key)
        ifM move

diff --git a/Command/RemoteDaemon.hs b/Command/RemoteDaemon.hs
index 03f5eaaf3db3d064dfb7d896d05d0bad9b313e6a..8c3226d05ebd44b3c6af307366eca8dd717e90fd 100644 (file)
--- a/Command/RemoteDaemon.hs
+++ b/Command/RemoteDaemon.hs
@@ -29,7 +29,7 @@ run o
        | foregroundDaemonOption o = liftIO runInteractive
        | otherwise = do
 #ifndef mingw32_HOST_OS
-               git_annex <- liftIO programPath
+               git_annex <- fromOsPath <$> liftIO programPath
                ps <- gitAnnexDaemonizeParams
                let logfd = openFdWithMode (toRawFilePath "/dev/null") ReadOnly Nothing defaultFileFlags
                liftIO $ daemonize git_annex ps logfd Nothing False runNonInteractive

diff --git a/Command/Repair.hs b/Command/Repair.hs
index c85c77d2992664f5f383bbb2203c0d3b3859f3ce..5e7a6dfdc6de5890d6d0506d1884881e2bc88815 100644 (file)
--- a/Command/Repair.hs
+++ b/Command/Repair.hs
@@ -14,7 +14,6 @@ import qualified Annex.Branch
 import qualified Git.Ref
 import Git.Types
 import Annex.Version
-import qualified Utility.RawFilePath as R
 
 cmd :: Command
 cmd = noCommit $ dontCheck repoExists $
@@ -76,7 +75,7 @@ repairAnnexBranch modifiedbranches
                Annex.Branch.forceCommit "committing index after git repository repair"
                liftIO $ putStrLn "Successfully recovered the git-annex branch using .git/annex/index"
        nukeindex = do
-               inRepo $ removeWhenExistsWith R.removeLink . gitAnnexIndex
+               inRepo $ removeWhenExistsWith removeFile . gitAnnexIndex
                liftIO $ putStrLn "Had to delete the .git/annex/index file as it was corrupt."
        missingbranch = liftIO $ putStrLn "Since the git-annex branch is not up-to-date anymore. It would be a very good idea to run: git annex fsck --fast"
 

diff --git a/Command/ResolveMerge.hs b/Command/ResolveMerge.hs
index 2d003547b2a88b61aecc14b71a4065378c5bdb47..4ba9cc8c89c2c585483d5c33961406285e0d25ed 100644 (file)
--- a/Command/ResolveMerge.hs
+++ b/Command/ResolveMerge.hs
@@ -16,8 +16,6 @@ import qualified Git.Branch
 import Annex.AutoMerge
 import qualified Utility.FileIO as F
 
-import qualified System.FilePath.ByteString as P
-
 cmd :: Command
 cmd = command "resolvemerge" SectionPlumbing
        "resolve merge conflicts"
@@ -30,7 +28,7 @@ start :: CommandStart
 start = starting "resolvemerge" (ActionItemOther Nothing) (SeekInput []) $ do
        us <- fromMaybe nobranch <$> inRepo Git.Branch.current
        d <- fromRepo Git.localGitDir
-       let merge_head = toOsPath $ d P.</> "MERGE_HEAD"
+       let merge_head = d </> literalOsPath "MERGE_HEAD"
        them <- fromMaybe (giveup nomergehead) . extractSha
                <$> liftIO (F.readFile' merge_head)
        ifM (resolveMerge (Just us) them False)
@@ -41,4 +39,4 @@ start = starting "resolvemerge" (ActionItemOther Nothing) (SeekInput []) $ do
                )
   where
        nobranch = giveup "No branch is currently checked out."
-       nomergehead = giveup "No SHA found in .git/merge_head"
+       nomergehead = giveup "No SHA found in .git/MERGE_HEAD"

diff --git a/Command/RmUrl.hs b/Command/RmUrl.hs
index d7a2b396fda642afe4efaf9c71d6c3afc48c6664..17c734c5b20fbcd690582e660f5e6f322742a96b 100644 (file)
--- a/Command/RmUrl.hs
+++ b/Command/RmUrl.hs
@@ -32,29 +32,28 @@ seek :: RmUrlOptions -> CommandSeek
 seek o = case batchOption o of
        Batch fmt -> batchOnly Nothing (rmThese o) $
                batchInput fmt batchParser (batchCommandAction . start)
-       NoBatch -> withPairs (commandAction . start) (rmThese o)
+       NoBatch -> withPairs (commandAction . start . conv) (rmThese o)
+  where
+       conv (si, (f, u)) = (si, (toOsPath f, u))
 
--- Split on the last space, since a FilePath can contain whitespace,
+-- Split on the last space, since a OsPath can contain whitespace,
 -- but a url should not.
-batchParser :: String -> Annex (Either String (FilePath, URLString))
+batchParser :: String -> Annex (Either String (OsPath, URLString))
 batchParser s = case separate (== ' ') (reverse s) of
        (ru, rf)
                | null ru || null rf -> return $ Left "Expected: \"file url\""
                | otherwise -> do
-                       let f = reverse rf
-                       f' <- liftIO $ fromRawFilePath
-                               <$> relPathCwdToFile (toRawFilePath f)
+                       let f = toOsPath (reverse rf)
+                       f' <- liftIO $ relPathCwdToFile f
                        return $ Right (f', reverse ru)
 
-start :: (SeekInput, (FilePath, URLString)) -> CommandStart
-start (si, (file, url)) = lookupKeyStaged file' >>= \case
+start :: (SeekInput, (OsPath, URLString)) -> CommandStart
+start (si, (file, url)) = lookupKeyStaged file >>= \case
        Nothing -> stop
        Just key -> do
-               let ai = mkActionItem (key, AssociatedFile (Just file'))
+               let ai = mkActionItem (key, AssociatedFile (Just file))
                starting "rmurl" ai si $
                        next $ cleanup url key
-  where
-       file' = toRawFilePath file
 
 cleanup :: String -> Key -> CommandCleanup
 cleanup url key = do

diff --git a/Command/SendKey.hs b/Command/SendKey.hs
index 4d92656ffb87e6a5f9569cc1f8a83f5f8dcfeb0b..12f3382a19e58a8595ad89eca1e7736c8eda3119 100644 (file)
--- a/Command/SendKey.hs
+++ b/Command/SendKey.hs
@@ -33,7 +33,9 @@ start (_, key) = do
        ifM (inAnnex key)
                ( fieldTransfer Upload key $ \_p ->
                        sendAnnex key Nothing rollback $ \f _sz -> 
-                               liftIO $ rsyncServerSend (map Param opts) f
+                               liftIO $ rsyncServerSend
+                                       (map Param opts)
+                                       (fromOsPath f)
                , do
                        warning "requested key is not present"
                        liftIO exitFailure

diff --git a/Command/SetKey.hs b/Command/SetKey.hs
index 820ab4af58424b48fa57a3f874c0c876c2729509..b7db0200df8ac6e68d7513cfb6121feace7a1de6 100644 (file)
--- a/Command/SetKey.hs
+++ b/Command/SetKey.hs
@@ -25,13 +25,13 @@ start ps@(keyname:file:[]) = starting "setkey" ai si $
   where
        ai = ActionItemOther (Just (QuotedPath file'))
        si = SeekInput ps
-       file' = toRawFilePath file
+       file' = toOsPath file
 start _ = giveup "specify a key and a content file"
 
 keyOpt :: String -> Key
 keyOpt = fromMaybe (giveup "bad key") . deserializeKey
 
-perform :: RawFilePath -> Key -> CommandPerform
+perform :: OsPath -> Key -> CommandPerform
 perform file key = do
        -- the file might be on a different filesystem, so moveFile is used
        -- rather than simply calling moveAnnex; disk space is also

diff --git a/Command/Smudge.hs b/Command/Smudge.hs
index 89f637dd52a038eed25b9aac37ef502de5ddaffc..355dd7a647d05122cf2511bcbc47ce527d91d922 100644 (file)
--- a/Command/Smudge.hs
+++ b/Command/Smudge.hs
@@ -44,7 +44,7 @@ cmd = noCommit $ noMessages $
                paramFile (seek <$$> optParser)
 
 data SmudgeOptions = UpdateOption | SmudgeOptions
-       { smudgeFile :: FilePath
+       { smudgeFile :: OsPath
        , cleanOption :: Bool
        }
 
@@ -52,14 +52,14 @@ optParser :: CmdParamsDesc -> Parser SmudgeOptions
 optParser desc = smudgeoptions <|> updateoption
   where
        smudgeoptions = SmudgeOptions
-               <$> argument str ( metavar desc )
+               <$> (stringToOsPath <$> argument str ( metavar desc ))
                <*> switch ( long "clean" <> help "clean filter" )
        updateoption = flag' UpdateOption
                ( long "update" <> help "populate annexed worktree files" )
 
 seek :: SmudgeOptions -> CommandSeek
 seek (SmudgeOptions f False) = commandAction (smudge f)
-seek (SmudgeOptions f True) = commandAction (clean (toRawFilePath f))
+seek (SmudgeOptions f True) = commandAction (clean f)
 seek UpdateOption = commandAction update
 
 -- Smudge filter is fed git file content, and if it's a pointer to an
@@ -73,7 +73,7 @@ seek UpdateOption = commandAction update
 -- * To support annex.thin
 -- * Because git currently buffers the whole object received from the
 --   smudge filter in memory, which is a problem with large files.
-smudge :: FilePath -> CommandStart
+smudge :: OsPath -> CommandStart
 smudge file = do
        b <- liftIO $ L.hGetContents stdin
        smudge' file b
@@ -81,18 +81,18 @@ smudge file = do
        stop
 
 -- Handles everything except the IO of the file content.
-smudge' :: FilePath -> L.ByteString -> Annex ()
+smudge' :: OsPath -> L.ByteString -> Annex ()
 smudge' file b = case parseLinkTargetOrPointerLazy b of
        Nothing -> noop
        Just k -> do
-               topfile <- inRepo (toTopFilePath (toRawFilePath file))
+               topfile <- inRepo (toTopFilePath file)
                Database.Keys.addAssociatedFile k topfile
                void $ smudgeLog k topfile
 
 -- Clean filter is fed file content on stdin, decides if a file
 -- should be stored in the annex, and outputs a pointer to its
 -- injested content if so. Otherwise, the original content.
-clean :: RawFilePath -> CommandStart
+clean :: OsPath -> CommandStart
 clean file = do
        Annex.BranchState.disableUpdate -- optimisation
        b <- liftIO $ L.hGetContents stdin
@@ -116,7 +116,7 @@ clean file = do
 
 -- Handles everything except the IO of the file content.
 clean'
-       :: RawFilePath
+       :: OsPath
        -> Either InvalidAppendedPointerFile (Maybe Key)
        -- ^ If the content provided by git is an annex pointer,
        -- this is the key it points to.
@@ -188,7 +188,7 @@ clean' file mk passthrough discardreststdin emitpointer =
                emitpointer
                        =<< postingest
                        =<< (\ld -> ingest' preferredbackend nullMeterUpdate ld Nothing norestage)
-                       =<< lockDown cfg (fromRawFilePath file)
+                       =<< lockDown cfg file
 
        postingest (Just k, _) = do
                logStatus NoLiveUpdate k InfoPresent
@@ -203,7 +203,7 @@ clean' file mk passthrough discardreststdin emitpointer =
 
 -- git diff can run the clean filter on files outside the
 -- repository; can't annex those
-fileOutsideRepo :: RawFilePath -> Annex Bool
+fileOutsideRepo :: OsPath -> Annex Bool
 fileOutsideRepo file = do
         repopath <- liftIO . absPath =<< fromRepo Git.repoPath
        filepath <- liftIO $ absPath file
@@ -232,7 +232,7 @@ inSmudgeCleanFilter = bracket setup cleanup . const
 -- in the index, and has the same content, leave it in git.
 -- This handles cases such as renaming a file followed by git add,
 -- which the user naturally expects to behave the same as git mv.
-shouldAnnex :: RawFilePath -> Maybe (Sha, FileSize, ObjectType) -> Maybe Key -> Annex Bool
+shouldAnnex :: OsPath -> Maybe (Sha, FileSize, ObjectType) -> Maybe Key -> Annex Bool
 shouldAnnex file indexmeta moldkey = do
        ifM (annexGitAddToAnnex <$> Annex.getGitConfig)
                ( checkunchanged $ checkmatcher checkwasannexed
@@ -299,7 +299,7 @@ shouldAnnex file indexmeta moldkey = do
 -- This also handles the case where a copy of a pointer file is made,
 -- then git-annex gets the content, and later git add is run on
 -- the pointer copy. It will then be populated with the content.
-getMoveRaceRecovery :: Key -> RawFilePath -> Annex ()
+getMoveRaceRecovery :: Key -> OsPath -> Annex ()
 getMoveRaceRecovery k file = void $ tryNonAsync $
        whenM (inAnnex k) $ do
                obj <- calcRepo (gitAnnexLocation k)

diff --git a/Command/Status.hs b/Command/Status.hs
index d6b2358f666d33d4024810c9ecc0ca1650d7243b..4ad00501a76472fbec55bedf2a61f02f7d779a99 100644 (file)
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -66,6 +66,6 @@ displayStatus s = do
        absf <- fromRepo $ fromTopFilePath (statusFile s)
        f <- liftIO $ relPathCwdToFile absf
        qp <- coreQuotePath <$> Annex.getGitConfig
-       unlessM (showFullJSON $ JSONChunk [("status", [c]), ("file", fromRawFilePath f)]) $
+       unlessM (showFullJSON $ JSONChunk [("status", [c]), ("file", fromOsPath f)]) $
                liftIO $ B8.putStrLn $ quote qp $
                        UnquotedString (c : " ") <> QuotedPath f

diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs
index eb643d7aad643452e51e47afa3fbead8242098eb..b35ee6ecb240882b36c924f1d60101834c81438f 100644 (file)
--- a/Command/TestRemote.hs
+++ b/Command/TestRemote.hs
@@ -87,8 +87,7 @@ start o = starting "testremote" (ActionItemOther (Just (UnquotedString (testRemo
                                showAction "generating test keys"
                                NE.fromList
                                        <$> mapM randKey (keySizes basesz fast)
-               fs -> NE.fromList
-                       <$> mapM (getReadonlyKey r . toRawFilePath) fs
+               fs -> NE.fromList <$> mapM (getReadonlyKey r . toOsPath) fs
        let r' = if null (testReadonlyFile o)
                then r
                else r { Remote.readonly = True }
@@ -256,15 +255,15 @@ test runannex mkr mkk =
                get r k
        , check "fsck downloaded object" fsck
        , check "retrieveKeyFile resume from 0" $ \r k -> do
-               tmp <- toOsPath <$> prepTmp k
+               tmp <- prepTmp k
                liftIO $ F.writeFile' tmp mempty
                lockContentForRemoval k noop removeAnnex
                get r k
        , check "fsck downloaded object" fsck
        , check "retrieveKeyFile resume from 33%" $ \r k -> do
-               loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)
-               tmp <- toOsPath <$> prepTmp k
-               partial <- liftIO $ bracket (openBinaryFile loc ReadMode) hClose $ \h -> do
+               loc <- Annex.calcRepo (gitAnnexLocation k)
+               tmp <- prepTmp k
+               partial <- liftIO $ bracket (F.openBinaryFile loc ReadMode) hClose $ \h -> do
                        sz <- hFileSize h
                        L.hGet h $ fromInteger $ sz `div` 3
                liftIO $ F.writeFile tmp partial
@@ -272,8 +271,8 @@ test runannex mkr mkk =
                get r k
        , check "fsck downloaded object" fsck
        , check "retrieveKeyFile resume from end" $ \r k -> do
-               loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)
-               tmp <- fromRawFilePath <$> prepTmp k
+               loc <- Annex.calcRepo (gitAnnexLocation k)
+               tmp <- prepTmp k
                void $ liftIO $ copyFileExternal CopyAllMetaData loc tmp
                lockContentForRemoval k noop removeAnnex
                get r k
@@ -303,7 +302,7 @@ test runannex mkr mkk =
                                loc <- Annex.calcRepo (gitAnnexLocation k)
                                verifier k loc
        get r k = logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
-               tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case
+               tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate (RemoteVerify r)) >>= \case
                        Right v -> return (True, v)
                        Left _ -> return (False, UnVerified)
        store r k = Remote.storeKey r k (AssociatedFile Nothing) Nothing nullMeterUpdate
@@ -342,8 +341,8 @@ testExportTree runannex mkr mkk1 mkk2 =
        -- renames are not tested because remotes do not need to support them
        ]
   where
-       testexportdirectory = "testremote-export"
-       testexportlocation = mkExportLocation (toRawFilePath (testexportdirectory </> "location"))
+       testexportdirectory = literalOsPath "testremote-export"
+       testexportlocation = mkExportLocation (testexportdirectory </> literalOsPath "location")
        check desc a = testCase desc $ do
                let a' = mkr >>= \case
                        Just r -> do
@@ -354,17 +353,17 @@ testExportTree runannex mkr mkk1 mkk2 =
                        Nothing -> return True
                runannex a' @? "failed"
        storeexport ea k = do
-               loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)
+               loc <- Annex.calcRepo (gitAnnexLocation k)
                Remote.storeExport ea loc k testexportlocation nullMeterUpdate
-       retrieveexport ea k = withTmpFile (toOsPath "exported") $ \tmp h -> do
+       retrieveexport ea k = withTmpFile (literalOsPath "exported") $ \tmp h -> do
                liftIO $ hClose h
-               tryNonAsync (Remote.retrieveExport ea k testexportlocation (fromRawFilePath (fromOsPath tmp)) nullMeterUpdate) >>= \case
+               tryNonAsync (Remote.retrieveExport ea k testexportlocation tmp nullMeterUpdate) >>= \case
                        Left _ -> return False
-                       Right v -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify v k (fromOsPath tmp)
+                       Right v -> verifyKeyContentPostRetrieval RetrievalAllKeysSecure AlwaysVerify v k tmp
        checkpresentexport ea k = Remote.checkPresentExport ea k testexportlocation
        removeexport ea k = Remote.removeExport ea k testexportlocation
        removeexportdirectory ea = case Remote.removeExportDirectory ea of
-               Just a -> a (mkExportDirectory (toRawFilePath testexportdirectory))
+               Just a -> a (mkExportDirectory testexportdirectory)
                Nothing -> noop
 
 testUnavailable :: RunAnnex -> Annex (Maybe Remote) -> Annex Key -> [TestTree]
@@ -377,14 +376,14 @@ testUnavailable runannex mkr mkk =
                Remote.checkPresent r k
        , check (== Right False) "retrieveKeyFile" $ \r k ->
                logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest ->
-                       tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate (RemoteVerify r)) >>= \case
+                       tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) dest nullMeterUpdate (RemoteVerify r)) >>= \case
                                Right v -> return (True, v)
                                Left _ -> return (False, UnVerified)
        , check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of
                Nothing -> return False
                Just a -> logStatusAfter NoLiveUpdate k $ getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) Nothing $ \dest -> 
                        unVerified $ isRight
-                               <$> tryNonAsync (a k (AssociatedFile Nothing) (fromRawFilePath dest))
+                               <$> tryNonAsync (a k (AssociatedFile Nothing) dest)
        ]
   where
        check checkval desc a = testCase desc $ 
@@ -430,24 +429,24 @@ keySizes base fast = filter want
                | otherwise = sz > 0
 
 randKey :: Int -> Annex Key
-randKey sz = withTmpFile (toOsPath "randkey") $ \f h -> do
+randKey sz = withTmpFile (literalOsPath "randkey") $ \f h -> do
        gen <- liftIO (newGenIO :: IO SystemRandom)
        case genBytes sz gen of
                Left e -> giveup $ "failed to generate random key: " ++ show e
                Right (rand, _) -> liftIO $ B.hPut h rand
        liftIO $ hClose h
        let ks = KeySource
-               { keyFilename = fromOsPath f
-               , contentLocation = fromOsPath f
+               { keyFilename = f
+               , contentLocation = f
                , inodeCache = Nothing
                }
        k <- case Types.Backend.genKey Backend.Hash.testKeyBackend of
                Just a -> a ks nullMeterUpdate
                Nothing -> giveup "failed to generate random key (backend problem)"
-       _ <- moveAnnex k (AssociatedFile Nothing) (fromOsPath f)
+       _ <- moveAnnex k (AssociatedFile Nothing) f
        return k
 
-getReadonlyKey :: Remote -> RawFilePath -> Annex Key
+getReadonlyKey :: Remote -> OsPath -> Annex Key
 getReadonlyKey r f = do
        qp <- coreQuotePath <$> Annex.getGitConfig
        lookupKey f >>= \case

diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs
index ee985ddf9ab51b66c242d47e5a9b2af238de9300..9732e7d65657a29c6ed5794be2866b267b1bf632 100644 (file)
--- a/Command/TransferKey.hs
+++ b/Command/TransferKey.hs
@@ -30,7 +30,7 @@ optParser :: CmdParamsDesc -> Parser TransferKeyOptions
 optParser desc  = TransferKeyOptions
        <$> cmdParams desc
        <*> parseFromToOptions
-       <*> (AssociatedFile <$> optional (strOption
+       <*> (AssociatedFile . fmap stringToOsPath <$> optional (strOption
                ( long "file" <> metavar paramFile
                <> help "the associated file"
                )))
@@ -64,7 +64,7 @@ fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
 fromPerform key af remote = go Upload af $
        download' (uuid remote) key af Nothing stdRetry $ \p ->
                logStatusAfter NoLiveUpdate key $ getViaTmp (retrievalSecurityPolicy remote) vc key af Nothing $ \t ->
-                       tryNonAsync (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p vc) >>= \case
+                       tryNonAsync (Remote.retrieveKeyFile remote key af t p vc) >>= \case
                                Right v -> return (True, v)     
                                Left e -> do
                                        warning (UnquotedString (show e))

diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs
index db22b64897ab6d1c12da028318c1f785405c21ad..f06a687c713c5ee64b0a4958daed430d00a8b4be 100644 (file)
--- a/Command/TransferKeys.hs
+++ b/Command/TransferKeys.hs
@@ -51,7 +51,7 @@ start = do
                | otherwise = notifyTransfer direction af $
                        download' (Remote.uuid remote) key af Nothing stdRetry $ \p ->
                                logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key af Nothing $ \t -> do
-                                       r <- tryNonAsync (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p (RemoteVerify remote)) >>= \case
+                                       r <- tryNonAsync (Remote.retrieveKeyFile remote key af t p (RemoteVerify remote)) >>= \case
                                                Left e -> do
                                                        warning (UnquotedString (show e))
                                                        return (False, UnVerified)
@@ -128,10 +128,10 @@ instance TCSerialized Direction where
        deserialize _ = Nothing
 
 instance TCSerialized AssociatedFile where
-       serialize (AssociatedFile (Just f)) = fromRawFilePath f
+       serialize (AssociatedFile (Just f)) = fromOsPath f
        serialize (AssociatedFile Nothing) = ""
        deserialize "" = Just (AssociatedFile Nothing)
-       deserialize f = Just (AssociatedFile (Just (toRawFilePath f)))
+       deserialize f = Just (AssociatedFile (Just (toOsPath f)))
 
 instance TCSerialized RemoteName where
        serialize n = n

diff --git a/Command/Transferrer.hs b/Command/Transferrer.hs
index 79568bf4afaba0a9335be35c461b03bea5cb01bf..f84f78359710da5dcb68c289d18283df52ae04e8 100644 (file)
--- a/Command/Transferrer.hs
+++ b/Command/Transferrer.hs
@@ -56,7 +56,7 @@ start = do
                -- and for retrying, and updating location log,
                -- and stall canceling.
                let go p = getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key af Nothing $ \t -> do
-                       Remote.verifiedAction (Remote.retrieveKeyFile remote key af (fromRawFilePath t) p (RemoteVerify remote))
+                       Remote.verifiedAction (Remote.retrieveKeyFile remote key af t p (RemoteVerify remote))
                in download' (Remote.uuid remote) key af Nothing noRetry go 
                        noNotification
        runner (AssistantUploadRequest _ key (TransferAssociatedFile af)) remote =
@@ -73,7 +73,7 @@ start = do
                notifyTransfer Download file $
                        download' (Remote.uuid remote) key file Nothing stdRetry $ \p ->
                                logStatusAfter NoLiveUpdate key $ getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file Nothing $ \t -> do
-                                       r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p (RemoteVerify remote)) >>= \case
+                                       r <- tryNonAsync (Remote.retrieveKeyFile remote key file t p (RemoteVerify remote)) >>= \case
                                                Left e -> do
                                                        warning (UnquotedString (show e))
                                                        return (False, UnVerified)

diff --git a/Utility/OsPath.hs b/Utility/OsPath.hs
index 150d06ae26652c094461e83144c55598cfd0e5b0..e751db5f0bdf93d24201b8caae31a4768c15297f 100644 (file)
--- a/Utility/OsPath.hs
+++ b/Utility/OsPath.hs
@@ -15,11 +15,12 @@ module Utility.OsPath (
        OsString,
        RawFilePath,
        literalOsPath,
+       stringToOsPath,
        toOsPath,
        fromOsPath,
        module X,
        getSearchPath,
-       unsafeFromChar
+       unsafeFromChar,
 ) where
 
 import Utility.FileSystemEncoding
@@ -101,7 +102,9 @@ bytesFromOsPath = getPosixString . getOsString
 getSearchPath :: IO [OsPath]
 getSearchPath = map toOsPath <$> PB.getSearchPath
 
-{- Used for string constants. -}
+{- Used for string constants. Note that when using OverloadedStrings,
+ - the IsString instance for ShortByteString only works properly with
+ - ASCII characters. -}
 literalOsPath :: ShortByteString -> OsPath
 literalOsPath = toOsPath
 
@@ -130,3 +133,6 @@ unsafeFromChar = fromIntegral . ord
 literalOsPath :: RawFilePath -> OsPath
 literalOsPath = id
 #endif
+
+stringToOsPath :: String -> OsPath
+stringToOsPath = toOsPath